home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 68.7z / BS1 part 68 / InterChange Plus v3.0 (1993-11)(Syndesis)(Disk 2 of 2).7z / InterChange Plus v3.0 (1993-11)(Syndesis)(Disk 2 of 2).adf / PC_Tools.LZH / ALISP.ZIP / CHG-FACE.LSP < prev    next >
Lisp/Scheme  |  1993-10-06  |  4KB  |  110 lines

  1. ; CHG-FACE.LSP  by Stephen Dodd                                       7/12/92
  2. ;
  3. ; This program will provide a way to edit 3DFACES in a way similar to the
  4. ; PEDIT command, allowing the user to toggle visibility of individual edges
  5. ; and move vertexes.
  6. ;
  7. ; ***************************************************************************
  8.  
  9. (defun CHG-FACE ( / F N A K E E1 E2 E3 E4 Emax P Pmax P1 P2 P3 P4 N PB D Q X1 X2 X3 X4 )
  10.  
  11. ;--------------------------- SELECT ENTITY ---------------------------------;
  12.  
  13.  (while (/= "3DFACE" (cdr(assoc 0 (setq F (entget(setq N (car(entsel)))))))))
  14.  
  15. ;------------------------- INITIALIZE SETTINGS -----------------------------;
  16.  
  17.  (setq A (cdr(assoc 70 F)) K 177 E 1 E1 0 E2 0 E3 0 E4 0 Emax 3 P 1 Pmax 6
  18.        P1 (trans(cdr(assoc 10 F)) N 1) P2 (trans(cdr(assoc 11 F)) N 1) D "N"
  19.        P3 (trans(cdr(assoc 12 F)) N 1) X1 NIL X2 NIL X3 NIL X4 NIL
  20.  )
  21.  (if(assoc 13 F) (setq P4 (trans(cdr(assoc 13 F)) N 1) Emax 4 Pmax 8))
  22.  (if(>= A 8)(setq E4 8 A (- A 8))) (if(>= A 4)(setq E3 4 A (- A 4)))
  23.  (if(>= A 2)(setq E2 2 A (- A 2))) (if(>= A 1)(setq E1 1 A (- A 1)))
  24.  
  25. ;------------------------------ START EDITOR -------------------------------;
  26.  
  27.  (while(not(member K '(1 88 120)))
  28.  
  29. ;----------------------- ERASE TEMPORARY VECTORS ---------------------------;
  30.  
  31.   (draw-x P1 0)  (draw-x P2 0)  (draw-x P3 0)  (draw-x P4 0)
  32.  
  33. ;--------------- INK or XOR-INK EDGES depending on VISIBILITY ---------------;
  34.  
  35.   (grdraw P1 P2 4 (if(= E1 0) 0 1))  (grdraw P2 P3 4 (if(= E2 0) 0 1))
  36.   (grdraw P3 P4 4 (if(= E3 0) 0 1))  (grdraw P4 P1 4 (if(= E4 0) 0 1))
  37.  
  38. ;---------------------- HIGHLIGHT SELECTED EDGE OR POINT --------------------;
  39.  
  40.   (cond
  41.    ((= P 1)(draw-x P1 2))   ((= P 2)(grdraw P1 P2 2 (if(= E1 0) 0 1)))
  42.    ((= P 3)(draw-x P2 2))   ((= P 4)(grdraw P2 P3 2 (if(= E2 0) 0 1)))
  43.    ((= P 5)(draw-x P3 2))   ((= P 6)(grdraw P3 P4 2 (if(= E3 0) 0 1)))
  44.    ((= P 7)(draw-x P4 2))   ((= P 8)(grdraw P4 P1 2 (if(= E4 0) 0 1)))
  45.   )
  46.  
  47. ;---------------------------- OBTAIN USER INPUT -----------------------------;
  48.  
  49.   (if(member P '(2 4 6 8))(setq Q "Change visibility")(setq Q "Move vertex"))
  50.   (prompt(strcat "\rNext/Previous/" Q "/eXit<" D ">                 "))
  51.   (setq K (cadr(grread)))
  52.   (cond
  53.    ((or(= K 67)(= K 99))                               ;Cc
  54.     (cond
  55.      ((= P 2)(setq E1 (IF (= 0 E1) 1 0)))
  56.      ((= P 4)(setq E2 (IF (= 0 E2) 2 0)))
  57.      ((= P 6)(setq E3 (IF (= 0 E3) 4 0)))
  58.      ((= P 8)(setq E4 (IF (= 0 E4) 8 0)))
  59.     )
  60.    )
  61.    ((or(= K 77)(= K 109))                              ;Mm
  62.     (progn
  63.      (cond
  64.       ((= P 1)(setq X1 (getpoint P1 "New location")))
  65.       ((= P 3)(setq X2 (getpoint P2 "New location")))
  66.       ((= P 5)(setq X3 (getpoint P3 "New location")))
  67.       ((= P 7)(setq X4 (getpoint P4 "New location")))
  68.      )
  69.      (grdraw P1 P2 0) (grdraw P2 P3 0) (grdraw P3 P4 0) (grdraw P4 P1 0)
  70.      (cond
  71.       ( X1 (setq P1 X1 X1 NIL)) ( X2 (setq P2 X2 X2 NIL))
  72.       ( X3 (setq P3 X3 X3 NIL)) ( X4 (setq P4 X4 X4 NIL))
  73.      )
  74.     )
  75.    )
  76.    ((or(= K 78)(= K 110)) (setq D "N"))                ;Nn
  77.    ((or(= K 80)(= K 112)) (setq D "P"))                ;Pp
  78.    ((= K 13)                                           ;enter
  79.     (if
  80.      (= D "N") 
  81.      (setq P (if(= P Pmax) 1 (1+ P)))                  ;if "N"
  82.      (setq P (if(= P 1) Pmax (1- P)))                  ;if "P"
  83.     )
  84.    )
  85.   )
  86.  )
  87.  
  88. ;----------------------- ERASE TEMPORARY VECTORS ---------------------------;
  89.  
  90.  (draw-x P1 0)    (draw-x P2 0)    (draw-x P3 0)    (draw-x P4 0)
  91.  (grdraw P1 P2 0) (grdraw P2 P3 0) (grdraw P3 P4 0) (grdraw P4 P1 0)
  92.  
  93. ;---------------------------- CHANGE DATABASE -------------------------------;
  94.  
  95.  (setq F (subst (cons 70 (+ E1 E2 E3 E4)) (assoc 70 F) F)
  96.        F (subst (cons 10 P1) (assoc 10 F) F)
  97.        F (subst (cons 11 P2) (assoc 11 F) F)
  98.        F (subst (cons 12 P3) (assoc 12 F) F)
  99.  )
  100.  (if P4 (setq F (subst (cons 13 P4) (assoc 13 F) F)))
  101.  (entmod F)
  102.  (princ)
  103. )
  104.  
  105. (defun DRAW-X ( A B )
  106.  (setq PB (getvar "pickbox"))
  107.  (grdraw (polar A (* PI 0.25) PB) (polar A (* PI 1.25) PB) B 0)
  108.  (grdraw (polar A (* PI 0.75) PB) (polar A (* PI 1.75) PB) B 0)
  109. )
  110.